perm filename R[226,DBL] blob sn#043418 filedate 1973-05-21 generic text, type T, neo UTF8
06700	(DE DOUBLE (PP DD) (PROG ()
06800	  (SETQ P (CONS (PRINT (NTH DECK (RR))) P ))
06900	  (SETQ WAGER1 (PLUS WAGER WAGER))
07000	  (COND ((OVER P) (PRINT (QUOTE (YOU ARE OVER))) 
07050	       (SETQ  U (ADD1 U)) (STAT -1))
07100	        (T  (SETQ U (ADD1 U)))) 
07200	  (STICK P D]
07300	
07400	(DE SPLIT (PP DD) (PROG (P1)
07500	  (PRINT (QUOTE (OK WE WILL WORK ON FIRST)))
07600	  (SETQ H (CONS (PRINT (CAR P)) H ))
07700	M  (PRINT (QUOTE (YOU GET)))
07800	  (PRINT (NTH DECK (SETQ P1 (RR))))
07900	  (SETQ P (CONS P1 (CDR P)))
08000	L  (SETQ ACT (READ))
08100	  (COND ((MEMBER ACT (CDR ACTS)) (ACT P D)))
08200	  (COND ((OR (OVER P) (EQUAL ACT (QUOTE STICK)))
08300	    (COND (H (SETQ RES (CONS P RES))
08400	             (SETQ P (LIST (CAR H)))
08500	             (SETQ H (CDR H))
08600	             (PRINT (QUOTE (WORKING ON THE NEXT)))
08700	             (PRINT (LAST P))
08800	             (GO M))
08900	          (T (STICK P D)))
09000	          (T (GO L]
09100	
09200	(DE VALUE (L) (COND
09300	  (L (PLUS (NTH (QUOTE (11.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 10.0
09400	                10.0 10.0)) (CAR L)) (VALUE (CDR L))))
09450	  (T 0]
09500	
09600	(DE BVALUE (L) (COND ((OR (ZEROP (NACES L)) (LESS (VALUE L)
09700	    22.0)) (VALUE L))
09800	   (T  (SETQ NA (NACES L))(PROG () (SETQ V (VALUE L))
09900	                LL (SETQ NA (SUB1 NA))
10000	  (SETQ V (DIFFERENCE V 10.0))
10100	  (COND  ((OR (LESS V 22.0) 
10200	         (EQUAL NA 0)) (RETURN V))) (GO LL]
10300	(DE OVER (L) (NOT (LESS (BVALUE L) 22.0]
10400	
10500	(DE STICK (PP DD) (PROG ()
10600	  (PRINT (QUOTE (DEALER HAS)))
10700	  (PRINT (NTH DECK (CAR D)))
10800	  (SETQ D (CONS (RR) D))
10900	  (PRINT (NTH DECK (CAR D)))
11000	  (COND ((LESS (BVALUE D) 17.0)
11100	  (PRINT (QUOTE (DEALER HITS AND GETS A)))
11200	  (SETQ D (CONS (RR) D))
11300	  (PRINT (NTH DECK (CAR D))) (STICK P D))
11400	   ((LESS 21.0 (BVALUE D))
11500	    (PRINT (QUOTE (DEALER BUSTS)))
11600	    (STAT 2.0))
11700	   (T (PRINT (QUOTE (DEALER STICKS)))
11800	     (TALLY P D]
11900	
12000	(DE TALLY (PP      DD) (PROG ()
12100	  (SETQ V1 (BVALUE D))
12200	  (SETQ V2 (BVALUE P))
12300	  (STAT (DIFFERENCE V2 V1))
12400	  (COND (RES (SETQ P (CAR RES))
12500	             (SETQ RES (CDR RES))
12600	             (TALLY P D]
12700	
12800	(DE STAT (N) (AND (PRINT (QUOTE MONEY))
12900	                   (SETQ MONEY (PRINT (COND
13000	  ((EQUAL N 2.0) (PLUS MONEY (TIMES WAGER1 U)))
13100	  (T (DIFFERENCE MONEY (TIMES WAGER1 N]
13200	
13300	(DE NACES (L) (COND ((NULL L) 0)
13400	  ((EQUAL (CAR L) 1) (PLUS 1 (NACES (CDR L))))
13500	  (T (NACES (CDR L]
13600	
13700	(DE LESS (A B) (*LESS A B]